MACup: Giveaway 1996/Image.iso/Shareware & Demos/Web-Publishing/SNAP PrimeBase/Telephone & Tabler/Click Me!

Text File | 1996-06-19 | 14.0 KB | 675 lines | [TEXT/Itb1]

#Telephone Application
#=====================

#Login
#-----

/* THE NAME OF THE DATABASE TO USE: */
varchar DatabaseName        = "Telephone";

integer $DefCols            = 1;
integer $ClearRows            = 2;
integer $SetTitle            = 3;
integer $EnableBut            = 4;
integer $FillPopup            = 5;
integer $FillList            = 6;
integer $SetText            = 7;
integer $AddRow                = 8;
integer $DelRow                = 9;
integer $SetCol                = 10;
integer $SetWindow            = 11;
integer $PickRow            = 12;
integer $PickCol            = 13;
integer $Alert                = 14;
integer $Progress            = 15;
integer $Debug                = 16;
integer $Stop                = 17;
integer $Halt                = 18;

/* Alert types: */
integer $stop                = 1;
integer $caution            = 2;
integer $note                = 3;

varchar LastTitle            = "";
integer LastTitleCol        = 0;
integer AlertSignal            = 0;
integer $DoDeleteDept        = 1;
integer $DoDeleteType        = 2;
integer $DoDeleteNumber        = 3;
integer $DoCreateDB            = 4;

integer NewID                = 0;
/**
print $debug, "Progress test begins...";
int i = 1;
for (;;) {
    i++;
    $yield();
    print $progress, i/10, "Counting to 1000...", 1;
    if (i > 1000) break;
}
print $debug, "Test ends.";
**/

boolean found = $false;

describe databases;
for each {
    if (->1 == DatabaseName) {
        found = $true;
        break;
    }
}

if (found)
    open database :DatabaseName;
else {
    print $alert, $stop, DatabaseName + " database not found! Should I create it?", 2, "Create", "Cancel";
    AlertSignal = $DoCreateDB;
}

#ALERT
if (AlertSignal == $DoCreateDB) {
    if (@how == 1)
        execute file "CreateDB";
    else
        /* If cancel, then quit! */
        print $halt;
}

#ERROR
/* If an error occurs on login, then we halt the program! */
print 18; /* ($halt) - If an error occurs, it might not be defined! */

#Window 'WT' "Number Types"
#--------------------------

print $DefCols, 2, "Code", "Name";
select * from Type
into cType for extract;
print $ClearRows;
for each cType {
    print $AddRow;
    printrow cType;
}
print $PickCol, 2;
print $EnableBut, 1, 1, 0, 0;

#SELECT

select * from Type
into cType for extract;
print $ClearRows;
for each cType {
    print $AddRow;
    printrow cType;
}
print $EnableBut, 1, 1, 0, 0;

#UPDATE

if (@col == 2 and @row != 0) {
    print $SetCol, 2, @text;
    $updaterow(cType, 2, @text);
    update Type set name = @text where code = cType->1;
}

#PICK

if (@row == 0) {
    print $EnableBut, 1, 1, 0, 0;
    print $SetText, "";
}
else {
    fetch absolute @row of cType;
    if (@col == 1) {
        print $EnableBut, 1, 1, 0, 1;
        print $SetText, "";
    }
    else {
        print $EnableBut, 1, 1, 1, 1;
        print $SetText, cType->@col;
    }
}

#INSERT

begin;
/* Get the next id: */
select max(code)+1 from Type;
fetch;
if ($sqlcode == $sqlnotfound)
    NewID = 1;
else
    NewID = ->1;
/* Insert into the database: */
insert Type values (NewID, "NewType" + varchar(NewID));
commit;

/* Update memory cursor */
fetch last of cType;
fetch next of cType;
$insertrow(cType,  NewID, "NewType" + varchar(NewID));

/* Print to screen */
print $AddRow, NewID, "NewType" + varchar(NewID);

/* Select the new row: */
fetch last of cType;
print $PickRow, $rows(cType);
if (@col == 1) {
    print $EnableBut, 1, 1, 0, 1;
    print $SetText, "";
}
else {
    print $EnableBut, 1, 1, 1, 1;
    print $SetText, cType->@col;
}

#DELETE

if (@row > 0) {
    select count(*) from number where type = cType->1;
    fetch;
    if (->1 == 0) {
        AlertSignal = $DoDeleteType;
        print $alert, $stop, "Do you really want to delete the number type '"+cType->2+"'?", 2, "Delete", "Cancel";
    }
    else
        print $alert, $stop, "The number type '"+cType->2+"' cannot be deleted, it in use!", 1, "OK";
}

#ALERT

if (AlertSignal == $DoDeleteType) {
     AlertSignal = 0;
    if (@row > 0 and @how == 1) {
        delete Type where code = cType->1;

        fetch absolute @row of cType;
        $deleterow(cType);

        print $DelRow;

        if (@row > $rows(cType)) {
            print $EnableBut, 1, 1, 0, 0;
            print $SetText, "";
        }
        else {
            if (@col == 1) {
                print $EnableBut, 1, 1, 0, 0;
                print $SetText, "";
            }
            else {
                print $EnableBut, 1, 1, 1, 1;
                print $SetText, cType->@col;
            }
        }
    }
}

#Window 'WD' "Departments"
#-------------------------

print $DefCols, 2, "Code", "Name";
select * from Department
into cDept for extract;
print $ClearRows;
for each cDept {
    print $AddRow;
    printrow cDept;
}
print $PickCol, 2;
print $EnableBut, 1, 1, 0, 0;

#SELECT

select * from Department
into cDept for extract;
print $ClearRows;
for each cDept {
    print $AddRow;
    printrow cDept;
}
print $EnableBut, 1, 1, 0, 0;

#UPDATE

if (@col == 2 and @row != 0) {
    print $SetCol, 2, @text;
    $updaterow(cDept, 2, @text);
    update Department set name = @text where code = cDept->1;
}

#PICK

if (@row == 0) {
    print $EnableBut, 1, 1, 0, 0;
    print $SetText, "";
}
else {
    fetch absolute @row of cDept;
    if (@col == 1) {
        print $EnableBut, 1, 1, 0, 1;
        print $SetText, "";
    }
    else {
        print $EnableBut, 1, 1, 1, 1;
        print $SetText, cDept->@col;
    }
}

#INSERT

begin;
/* Get the next id: */
select max(code)+1 from Department;
fetch;
if ($sqlcode == $sqlnotfound)
    NewID = 1;
else
    NewID = ->1;
/* Insert into the database: */
insert Department values (NewID, "NewDept" + varchar(NewID));
commit;

/* Update memory cursor */
fetch last of cDept;
fetch next of cDept;
$insertrow(cDept, NewID, "NewDept" + varchar(NewID));

/* Print to screen */
print $AddRow, NewID, "NewDept" + varchar(NewID);

/* Select the new row: */
fetch last of cDept;
print $PickRow, $rows(cDept);
if (@col == 1) {
    print $EnableBut, 1, 1, 0, 1;
    print $SetText, "";
}
else {
    print $EnableBut, 1, 1, 1, 1;
    print $SetText, cDept->@col;
}

#DELETE

if (@row > 0) {
    select id from person where department = cDept->1;
    fetch;
    if ($sqlcode == $sqlnotfound) {
        AlertSignal = $DoDeleteDept;
        print $alert, $stop, "Do you really want to delete '"+cDept->2+"'?", 2, "Delete", "Cancel";
    }
    else
        print $alert, $stop, "The department '"+cDept->2+"' cannot be deleted, it in use!", 1, "OK";
}

#ALERT

if (AlertSignal == $DoDeleteDept) {
    AlertSignal = 0;
    if (@row > 0 and @how == 1) {
        delete Department where code = cDept->1;

        fetch absolute @row of cDept;
        $deleterow(cDept);

        print $DelRow;

        if (@row > $rows(cDept)) {
            print $EnableBut, 1, 1, 0, 0;
            print $SetText, "";
        }
        else {
            if (@col == 1) {
                print $EnableBut, 1, 1, 0, 0;
                print $SetText, "";
            }
            else {
                print $EnableBut, 1, 1, 1, 1;
                print $SetText, cDept->@col;
            }
        }
    }
}

#Window 'WN' "Telephone Numbers"
#-----------------------------

print $EnableBut, 1, 1, 0, 0;
print $DefCols, 5, "Type", "Name", "Surname", "Department", "Number";
print $FillPopup, 3, "<SELECT ALL>", "<SELECT ALL>", "Is Equal To:", "Contains:";
select Name from Type for extract;
print $FillList, $rowcnt;
for each print ->1;

select Type.Name, Person.Name, Person.Surname, Department.Name, Number.Number, Number.Person as kperson, Number.Type as ktype
from Department, Type, Person, Number
where $false
into cTelNum for extract;

#SELECT

if (LastTitleCol > 0) {
    print $SetTitle, LastTitleCol, LastTitle;
    LastTitleCol = 0;
}

if (@popup == "<SELECT ALL>") {
    select Type.Name, Person.Name, Person.Surname, Department.Name, Number.Number, Number.Person as kperson, Number.Type as ktype
    from Department, Type, Person, Number
    where
    Type.Code == Number.Type and
    Number.Person = Person.ID and
    Person.Department == Department.Code
    into cTelNum for extract;
}
else {
    varchar string, title;

    string =
    "select Type.Name, Person.Name, Person.Surname, Department.Name, Number.Number, Number.Person as kperson, Number.Type as ktype " +
    "from Department, Type, Person, Number where " +
    "Type.Code == Number.Type and " +
    "Number.Person = Person.ID and " +
    "Person.Department == Department.Code and ";

    /* COLUMN */
    switch (@col) {
        case 1:
            string = string + "Type.Name ";
            title = "Type";
            break;
        case 2:
            string = string + "Person.Name ";
            title = "Name";
            break;
        case 3:
            string = string + "Person.Surname ";
            title = "Surname";
            break;
        case 4:
            string = string + "Department.Name ";
            title = "Department";
            break;
        case 5:
            string = string + "varchar Number.Number ";
            title = "Number";
            break;
    }
    LastTitle = title;
    LastTitleCol = @col;

    /* CONDITION */
    if (@popup == "Is Equal To:") {
        string = string + "= '";
        title = title + " = '";
    }
    else {
        string = string + "LIKE '*";
        title = title + " LIKE '";
    }

    /* VALUE */
    string = string + @text;
    title = title + @text +"'";

    /* CONDITION */
    if (@popup == "Is Equal To:")
        string = string + "' ";
    else
        string = string + "*' ";

    string = string +
    "into cTelNum for extract;";

    print $SetTitle, @col, title;
    execute string;
}

print $ClearRows;
for each cTelNum {
    print $AddRow;
    print cTelNum->1, cTelNum->2, cTelNum->3, cTelNum->4, cTelNum->5;
}

#PICK

if (@col == 1) {
    select Name from Type for extract;
    print $FillList, $rowcnt;
    for each print ->1;
}
else if (@col == 4) {
    select Name from Department for extract;
    print $FillList, $rowcnt;
    for each print ->1;
}
else
    print $FillList, 0;

if (@row == 0)
    print $EnableBut, 1, 1, 0, 0;
else {
    print $EnableBut, 1, 1, 1, 1;
    fetch absolute @row of cTelNum;
    print $SetText, cTelNum->@col;
}

#UPDATE

if (@row != 0) {
    fetch absolute @row of cTelNum;
    switch (@col) {
        case 1:
            select * from Type where name = @text;
            fetch;
            if ($sqlcode != $sqlnotfound and cTelNum->1 !=  ->2) {
                select * from number where key = { cTelNum->kperson, ->1 } into cTmp for extract;
                if ($rows(cTmp) > 0) {
                    print $alert, $stop, cTelNum->2 + " " + cTelNum->3 + " already has a number of type '" + cTelNum->1 + "'.", 1, "OK";
                }
                else {
                    print $SetCol, 1, ->2;
                    $updaterow(cTelNum, 1, ->2);
                    update Number set type = ->1 where key = { cTelNum->kperson, cTelNum->ktype };
                }
            }
            break;
        case 2:
            print $SetCol, 2, @text;
            $updaterow(cTelNum, 2, @text);
            update Person set Name = @text where ID = cTelNum->kperson;
            break;
        case 3:
            print $SetCol, 3, @text;
            $updaterow(cTelNum, 3, @text);
            update Person set SurName = @text where ID = cTelNum->kperson;
            break;
        case 4:
            /* Update the persons department */
            select * from Department where name = @text;
            fetch;
            if ($sqlcode != $sqlnotfound) {
                print $SetCol, 4, ->2;
                $updaterow(cTelNum, 4, ->2);
                update Person set Department = ->1 where ID = cTelNum->kperson;
            }
            break;
        case 5:
            print $SetCol, 5, @text;
            $updaterow(cTelNum, 5, @text);
            update Number set Number = @text where key = { cTelNum->kperson, cTelNum->ktype };
            break;
    }
}

#INSERT
/* Add a new number... */
varchar newtype = "";
varchar newname = "";
varchar newsurname = "";
varchar newdept = "";
varchar newnumber = "";
boolean doinsert = $true;

switch (@col) {
    case 1: newtype = @text; break;
    case 2: newname = @text; break;
    case 3: newsurname = @text; break;
    case 4: newdept = @text; break;
    case 5: newnumber = @text; break;
}

if (@row == 0) {
    /* New department for the person: */
    if (newdept != "") {
        select * from Department where name = newdept;
        fetch;
        if ($sqlcode == $sqlnotfound)
            newdept = "";
    }

    if (newdept == "") {
        select * from Department;
        fetch;
    }

    /* Add a new person first... */
    /* Get the next id: */
    begin;
    select max(ID)+1 from Person into cTmp;
    fetch of cTmp;
    if ($sqlcode == $sqlnotfound)
        NewID = 100;
    else
        NewID = cTmp->1;

    /* Insert into the database: */
    if (newsurname == "")
        newsurname = "Person" + varchar(NewID);
    insert Person values (NewID, newname, newsurname, ->1);
    commit;

    if (newtype != "") {
        select * from Type where name = newtype into cTmp2;
        fetch next of cTmp2;
        if ($sqlcode == $sqlnotfound)
            newtype = "";
    }

    if (newtype == "") {
        select * from Type into cTmp2;
        fetch next of cTmp2;
    }

    fetch last of cTelNum;
    fetch next of cTelNum;
    $insertrow(cTelNum, cTmp2->2, newname, newsurname, ->2, newnumber, NewID, cTmp2->1);
}
else {
    /* New number for existing person... */
    fetch absolute @row of cTelNum;
    if (newtype != "") {
        select * from Type where name = newtype;
        fetch;
        if ($sqlcode == $sqlnotfound)
            newtype = "";
    }

    if (newtype != "") {
        /* Number of given type: */
        select * from number where key = { cTelNum->kperson, ->1 } into cTmp for extract;
        fetch of cTmp;
        if ($sqlcode != $sqlnotfound) {
            print $alert, $stop, cTelNum->2 + " " + cTelNum->3 + " already has a number of type '" + cTelNum->1 + "'.", 1, "OK";
            doinsert = $false;
        }
    }
    else {
        /* Number of ANY type: */
        select * from type where code not in (select type from number where person == cTelNum->kperson);
        fetch;
        if ($sqlcode == $sqlnotfound) {
            print $alert, $stop, cTelNum->2 + " " + cTelNum->3 + " already has all types of numbers.", 1, "OK";
            doinsert = $false;
        }
    }

    if (doinsert) {
        integer newperson;

        newname = cTelNum->2;
        newsurname = cTelNum->3;
        newdept = cTelNum->4;
        newperson = cTelNum->kperson;
        fetch last of cTelNum;
        fetch next of cTelNum;
        $insertrow(cTelNum, ->2, newname, newsurname, newdept, newnumber, newperson, ->1);
    }
}

if (doinsert) {
    /* Insert the number... */
    fetch last of cTelNum;
    insert Number values (cTelNum->kperson, cTelNum->ktype, newnumber);

    /* Print to screen */
    print $AddRow, cTelNum->1, cTelNum->2, cTelNum->3, cTelNum->4, cTelNum->5;

    print $EnableBut, 1, 1, 1, 1;
    print $PickRow, $rows(cTelNum);
    print $SetText, cTelNum->@col;
}

#DELETE

procedure DeleteNumber()
{
    if (@row != 0) {
        fetch absolute @row of cTelNum;
        select count(*) from number where person = cTelNum->kperson;
        fetch;
        if (->1 == 1)
            delete Person where id = cTelNum->kperson;

        delete Number where key = { cTelNum->kperson, cTelNum->ktype };
        $deleterow(cTelNum);
        print $DelRow;

        if (@row > $rows(cTelNum)) {
            print $EnableBut, 1, 1, 0, 0;
            print $SetText, "";
        }
        else {
            print $EnableBut, 1, 1, 1, 1;
            print $SetText, cTelNum->@col;
        }
    }
}
end procedure DeleteNumber;

/* Delete a telephone number: */
if (@row != 0) {
    fetch absolute @row of cTelNum;
    select count(*) from number where person = cTelNum->kperson;
    fetch;
    if (->1 <= 1) {
        AlertSignal = $DoDeleteNumber;
        print $alert, $stop, "Deleting this number will delete the person: " + cTelNum->2 + " " + cTelNum->3 + ". Delete anyway?", 2, "Delete", "Cancel";
    }
    else
        DeleteNumber();
}

#ALERT

if (AlertSignal == $DoDeleteNumber and @how == 1) {
     AlertSignal = 0;
     DeleteNumber();
}